home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / ftetra.F < prev    next >
Text File  |  1991-06-03  |  3KB  |  191 lines
  1. c
  2. c Demonstrate a rotating translating tetrahedron, and 
  3. c doublebuffering.
  4. c
  5.     program ftetra
  6.  
  7. #ifdef SGI
  8. #include "fgl.h"
  9. #include "fdevice.h"
  10. #else
  11. #include "fvogl.h"
  12. #include "fvodevice.h"
  13. #endif
  14.     integer TETRAHEDRON
  15.     parameter (TETRAHEDRON = 1)
  16.  
  17.     real R, tx, tz, zeye
  18.     integer rotval, drotval
  19.     logical    dobackface, dofill
  20.     character ans*1
  21.  
  22.     call prefsi(300, 300)
  23.  
  24.     print*,'Backfacing ON or OFF (Y/N)?'
  25.     read(*, '(a)') ans
  26.     dobackface = (ans .eq. 'y' .or. ans .eq. 'Y')
  27.  
  28.     print*,'Fill the polygons (Y/N)?'
  29.     read(*, '(a)') ans
  30.     dofill = (ans .eq. 'y' .or. ans .eq. 'Y')
  31.  
  32.     call winope('ftetra', 6)
  33.  
  34.     call double
  35.     call gconfi
  36.  
  37.     call unqdev(INPUTC)
  38.     call qdevic(QKEY)
  39.     call qdevic(ESCKEY)
  40. c
  41. c Make the tetrahedral object
  42. c
  43.     call makeit
  44.  
  45.     rotval = 0
  46.     drotval = 10
  47.     zeye = 5.0
  48.  
  49.     R = 1.6
  50.  
  51.     tx = 0.0
  52.     tz = R
  53.  
  54.     call polymo(PYM_LI)
  55.     if (dofill) call polymo(PYM_FI)
  56.     if (dobackface) call backfa(.true.)
  57.  
  58. c
  59. c set up a perspective projection with a field of view of
  60. c 40.0 degrees, aspect ratio of 1.0, near clipping plane 0.1,
  61. c and the far clipping plane at 1000.0.
  62. c
  63.     call perspe(400, 1.0, 0.001, 15.0)
  64.     call lookat(0.0, 0.0, zeye, 0.0, 0.0, 0.0, 0)
  65.  
  66.  
  67. c
  68. c here we loop back here adnaseum until someone hits a key
  69. c
  70.  10    continue
  71.  
  72.       rotval = 0
  73.  
  74.       do 20 i = 0, int(3590 / drotval)
  75.  
  76.         call color(BLACK)
  77.         call clear
  78.  
  79. c
  80. c Rotate the whole scene...(this acumulates - hence
  81. c drotval)
  82. c
  83.         call rotate(drotval, 'x')
  84.         call rotate(drotval, 'z')
  85.  
  86.         call color(RED)
  87.         call pushma
  88.         call rotate(900, 'x')
  89.         call circ(0.0, 0.0, R)
  90.         call popmat
  91.  
  92.         call color(BLUE)
  93.         call move(0.0, 0.0, 0.0)
  94.         call draw(tx, 0.0, tz)
  95.             
  96. c
  97. c Remember! The order of the transformations is
  98. c the reverse of what is specified here in between
  99. c the pushmatrix and the popmatrix. These ones don't
  100. c accumulate because of the push and pop.
  101. c
  102.  
  103.         call pushma
  104.         call transl(tx, 0.0, tz)
  105.         call rotate(rotval, 'x')
  106.         call rotate(rotval, 'y')
  107.         call rotate(rotval, 'z')
  108.         call scale(0.4, 0.4, 0.4)
  109.          call callob(TETRAHEDRON)
  110.         call popmat
  111.  
  112.         tz = R * cos(rotval * 3.1415926535 / 180)
  113.         tx = R * sin(rotval * 3.1415926535 / 180)
  114.  
  115.         call swapbu
  116.  
  117.         if (qtest()) then
  118.         call gexit
  119.         stop
  120.         endif
  121.  
  122.         rotval = rotval + drotval
  123.         if (rotval .gt. 3600) rotval = 3600
  124.  
  125.  20      continue
  126.  
  127.     goto 10
  128.         
  129.     end
  130.  
  131. c
  132. c maketheobject
  133. c
  134. c    generate a tetrahedron object as a series of move draws
  135. c
  136.     subroutine makeit
  137.  
  138. #ifdef SGI
  139. #include "fgl.h"
  140. #else
  141. #include "fvogl.h"
  142. #endif
  143.     integer TETRAHEDRON, NSIDES, NFACES, NPNTS
  144.     parameter (TETRAHEDRON = 1, NSIDES = 3, NFACES = 4, NPNTS = 4)
  145.  
  146.     integer colface(NFACES)
  147.  
  148.     real points(3, NPNTS), tmp(3)
  149.  
  150.     integer    faces(NSIDES, NFACES)
  151.  
  152.     integer i, j
  153.     real x, y, z
  154.  
  155.  
  156. cdata points/
  157. c+    -0.5, 0.866, -0.667,
  158. c+    -0.5, -0.866, -0.667,
  159. c+     1.0, 0.0, -0.667,
  160. c+     0.0, 0.0, 1.334/
  161.  
  162.       data points/
  163.      +    -0.5, 0.866, -0.667,
  164.      +    -0.5, -0.866, -0.667,
  165.      +     1.0, 0.0, -0.667,
  166.      +     0.0, 0.0, 1.334/
  167.  
  168.  
  169.     data colface/GREEN, YELLOW, CYAN, MAGENT/
  170.  
  171.     data faces/
  172.      +    3, 2, 1,
  173.      +    1, 2, 4,
  174.      +    2, 3, 4,
  175.      +    3, 1, 4/
  176.  
  177.      call makeob(TETRAHEDRON)
  178.  
  179.        do 20 i = 1, NFACES
  180.                 call color(colface(i))
  181.                 call bgnpol
  182.                 do 10 j = 1, NSIDES
  183.                     call v3f(points(1, faces(j, i)))
  184.  10             continue
  185.                 call endpol
  186.  20     continue
  187.  
  188.      call closeo
  189.     end
  190.  
  191.